ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UList.inc1.p

Text File | 1990-10-25 | 48.5 KB | 1,865 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UList.inc1.p }
{ Copyright © 1986-1990 by Apple Computer, Inc.  All rights reserved. }

{$IFC NOT qDebugTheDebugger}                            { Lists are core to MacApp. They really need
                                                         to be at least tolerable in the Debug
                                                         environment. }
{$W+}
{$Init-}
{$OV-}
{$ENDC}
{$IFC qNames}
{$D+}
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TPtrBasedDoublyLinkedList.IPtrBasedDoublyLinkedList;

    BEGIN
    IObject;

    fHeadNodePtr := NIL;
    fTailNodePtr := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TPtrBasedDoublyLinkedList.AppendNode(thisNode: UNIV PtrBasedDoublyLinkedListNodePtr);

    BEGIN
    { if a chain exists then link me in }
    IF fTailNodePtr <> NIL THEN
        BEGIN
        thisNode^.previousLink := fTailNodePtr;         { set my back link }
        fTailNodePtr^.nextLink := thisNode;             { set the old tail's forward link }
        thisNode^.nextLink := NIL;                        { I'm last }

        fTailNodePtr := thisNode;
        END
    ELSE                                                { start a new chain }
        BEGIN
        thisNode^.previousLink := NIL;                    { I'm first }
        thisNode^.nextLink := NIL;                        { I'm last }

        fHeadNodePtr := thisNode;
        fTailNodePtr := thisNode;
        END;

    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TPtrBasedDoublyLinkedList.RemoveNode(thisNode: UNIV PtrBasedDoublyLinkedListNodePtr);

    BEGIN
    { remove me from the list ends }
    IF fHeadNodePtr = thisNode THEN
        fHeadNodePtr := thisNode^.nextLink;
    IF fTailNodePtr = thisNode THEN
        fTailNodePtr := thisNode^.previousLink;

    { remove me from the chain }
    IF thisNode^.nextLink <> NIL THEN
        thisNode^.nextLink^.previousLink := thisNode^.previousLink;
    IF thisNode^.previousLink <> NIL THEN
        thisNode^.previousLink^.nextLink := thisNode^.nextLink;

    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TPtrBasedDoublyLinkedList.EachNodeDo(PROCEDURE
                                               DoToNode(thisNode: UNIV
                                                        PtrBasedDoublyLinkedListNodePtr));

    VAR
        aNodePtr:            PtrBasedDoublyLinkedListNodePtr;

    BEGIN
    aNodePtr := fTailNodePtr;
    WHILE (aNodePtr <> NIL) DO
        BEGIN
        DoToNode(aNodePtr);
        aNodePtr := aNodePtr^.previousLink;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TPtrBasedDoublyLinkedList.Fields(PROCEDURE
                                           DoToField(fieldName: Str255;
                                                     fieldAddr: Ptr;
                                                     fieldType: integer)); OVERRIDE;

    BEGIN
    DoToField('TPtrBasedDoublyLinkedList', NIL, bClass);
    DoToField('fHeadNodePtr', @fHeadNodePtr, bPointer);
    DoToField('fTailNodePtr', @fHeadNodePtr, bPointer);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.IDynamicArray(initialSize: ArrayIndex;
                                      elementSize: integer);

    BEGIN
    fFreeRequested := FALSE;                            { no comment can do this justice }

    IPtrBasedDoublyLinkedList;

    fClassSize := GetClassSize;                            { Store the class size for use in
                                                        computeAddress }

    IF qDebug & (initialSize < kEmptyIndex) THEN
        BEGIN
        ProgramBreak('initialSize must be non-negative!');
        initialSize := kEmptyIndex;                     {??? Ask programmer }
        END;

    IF qDebug & (elementSize <= 0) THEN
        BEGIN
        ProgramBreak('In TDynamicArray.IDynamicArray: preposterous element size. (zero or negative)'
                     );
        Failure(minErr, 0);
        END;

    fSize := kEmptyIndex;

    fElementSize := elementSize;
    fAllocatedSize := kEmptyIndex;

    fAllocationIncrement := kAllocationIncrement;        { !!! an enhancement would be to support
                                                         no-growth lists. i.e. fAllocationIncrement
                                                         of kEmptyIndex. the list would just stay
                                                         at the size it was allocated and wouldn't
                                                         shrink and signal failure if an operation
                                                         needed to grow it }

    { calculate the elementsizeshift that represents the nearest power of 2 }
    fElementSizeShift := 0;
    WHILE BSR(elementSize - 1, fElementSizeShift) > 0 DO
        fElementSizeShift := fElementSizeShift + 1;


    SetArraySize(initialSize);

    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.DeleteElementsAt(index: ArrayIndex;
                                         count: ArrayIndex);

    CONST
        initVal             = $F1;

    VAR
        indexPtr, nextElementPtr, lastElementPtr: Ptr;
        countBytes:         ArrayIndex;

    PROCEDURE DoToNode(thisNode: UNIV IterationNodePtr); { bends the index in the (usually local to
                                                          the Iterator) Iteration node to account
                                                          for the deleted elements }

        BEGIN
        WITH thisNode^ DO
            BEGIN
            IF iterForward THEN
                BEGIN
                { If the deleted element was NOT in the
                range yet to be iterated then bend the
                iterIndex to account for it. }
                IF index < iterLowBound THEN
                    iterLowBound := iterLowBound - count;

                IF index <= iterIndex THEN
                    iterIndex := iterIndex - count;

                IF index <= iterHighBound THEN
                    iterHighBound := iterHighBound - count;
                END
            ELSE                                        { Iterating backwards }
                BEGIN
                { If the deleted element was IN the range
                yet to be iterated then bend the iterIndex
                to account for it. }
                IF index < iterLowBound THEN
                    iterLowBound := iterLowBound - count;

                IF index < iterIndex THEN
                    iterIndex := iterIndex - count;

                IF index <= iterHighBound THEN
                    iterHighBound := iterHighBound - count;
                END;
            END;
        END;

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TDynamicArray.DeleteElementAt');
        END;

    countBytes := BSL(count, fElementSizeShift);

    indexPtr := ComputeAddress(index);
    nextElementPtr := ComputeAddress(index + count);
    lastElementPtr := ComputeAddress(fSize + 1);

    IF ord(nextElementPtr) < ord(lastElementPtr) THEN    { deleted from middle? Compress the array }
        BlockMove(nextElementPtr, indexPtr, ord(lastElementPtr) - ord(nextElementPtr));

    {$Push} {$R-}
    IF qDebug THEN
        BlockSet(Ptr(ord(lastElementPtr) - countBytes), countBytes, initVal);
    {$Pop}

    SetArraySize(fSize - count);                        { take up slack if necessary. Should never
                                                         Fail when shrinking array. }

    fSize := fSize - count;

    IF fTailNodePtr <> NIL THEN
        EachNodeDo(DoToNode);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.GetElementsAt(index: ArrayIndex;
                                      ElementPtr: UNIV Ptr;
                                      count: ArrayIndex);

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TDynamicArray.ReplaceElementAt');
        END;
    { The count computation for this blockmove makes sure that if the element size is not
    a power of 2 that we don't copy more bytes back to the caller than required for a
    given number of elements… sending the caller into orbit and heading straight for the Excedrin.

    !!! NOTE MULTIPLE (> 1) element moves for non-power of 2 element sizes are not yet supported! }

    IF count > kEmptyIndex THEN
        BlockMove(ComputeAddress(index), ElementPtr, BSL(count - 1, fElementSizeShift) +
                  fElementSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}
{$Push} {$IFC qTrace} {$D+} {$ENDC}{ Called _FREQUENTLY_ }

FUNCTION TDynamicArray.ComputeAddress(index: ArrayIndex): Ptr;
    VAR
        p: Ptr;

    BEGIN
    {$IFC FALSE}
    { This is the ideal situation.  Unfortunately it is too slow for something as
    widely used as Dynamic Arrays, so we break the encapsulation below.  If your subclass
    wishes to manage storage gotten from somewhere other than the object's handle then
    you must override GetDynamicPtr to return a pointer to the storage to be managed and
    ALSO override ComputeAddress to use this commented out code. }

    p := GetDynamicPtr;
    IF qDebug & (p = NIL) THEN
        DebugStr('ComputeAddress called with an empty list (no dynamic area allocated)');

    { p + ((index - 1) * fElementSize) }
    ComputeAddress := Ptr(ord(p) + BSL((index - 1), fElementSizeShift));
    {$EndC}

    { Break encapsulation and just return an index off of SELF which we know to be a handle
    MacApp 2.0 }
    ComputeAddress := Ptr(striplong(Handle(SELF)^) + fClassSize + BSL((index - 1), fElementSizeShift));
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.Free;

    BEGIN
    IF fTailNodePtr <> NIL THEN                         { She can't do it cap'n. The dilithium
                                                         crystals are burrrrnt out! If they're
                                                         allowed to rest a while they might recover
                                                         enough for another try. }
        BEGIN
        fFreeRequested := TRUE;
        { Release our dynamic portion now, but wait to be freed }
        IF fSize > kEmptyIndex THEN
            DeleteElementsAt(1, fSize);
        END
    ELSE
        INHERITED Free;

    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TDynamicArray.GetSize: ArrayIndex;

    BEGIN
    GetSize := fSize;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.InsertElementsBefore(index: ArrayIndex;
                                             ElementPtr: UNIV Ptr;
                                             count: ArrayIndex);

    VAR
        indexPtr, nextIndexPtr, lastElementPtr: Ptr;
        countBytes:         ArrayIndex;

    PROCEDURE DoToNode(thisNode: UNIV IterationNodePtr);
    { bends the index to account for the inserted elements }

        BEGIN
        WITH thisNode^ DO
            BEGIN
            IF iterForward THEN
                BEGIN
                { If the inserted element was NOT in the
                range yet to be iterated then bend the
                iterIndex to account for it. }
                IF index <= iterLowBound THEN
                    iterLowBound := iterLowBound + count;

                IF index <= iterIndex THEN
                    iterIndex := iterIndex + count;

                IF index <= iterHighBound THEN
                    iterHighBound := iterHighBound + count;
                END
            ELSE                                        { Iterating backward }
                BEGIN
                { If the inserted element was IN the range
                yet to be iterated then bend the iterIndex
                to account for it. }
                IF index <= iterLowBound THEN
                    iterLowBound := iterLowBound + count;

                IF index < iterIndex THEN
                    iterIndex := iterIndex + count;

                IF index <= iterHighBound THEN
                    iterHighBound := iterHighBound + count;
                END;
            END;
        END;

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize + 1)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TDynamicArray.InsertBefore');
        END;

    SetArraySize(fSize + count);                        { make sure there's room if needed }

    indexPtr := ComputeAddress(index);
    nextIndexPtr := ComputeAddress(index + count);
    lastElementPtr := ComputeAddress(fSize + 1);
    countBytes := BSL(count, fElementSizeShift);

    IF index <= fSize THEN                                { clear out a hole? }
        BlockMove(indexPtr, nextIndexPtr, ord(lastElementPtr) - ord(indexPtr));

    { !!! we still don't account for multiple element moves with non power of 2 element sizes.
    Would it be best to create a MoveElements method and put the smarts in it? }

    IF (countBytes = sizeof(longint)) & NOT odd(ord(ElementPtr)) & NOT odd(ord(indexPtr)) THEN
        LongintPtr(indexPtr)^ := LongintPtr(ElementPtr)^ { shortcut for longs }
    ELSE
        BlockMove(ElementPtr, indexPtr, countBytes);    { longcut for shorts (and other sizes) }

    fSize := fSize + count;

    IF fTailNodePtr <> NIL THEN
        EachNodeDo(DoToNode);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TDynamicArray.IsEmpty: Boolean;

    BEGIN
    IsEmpty := fSize = kEmptyIndex;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TDynamicArray.EachElementDoTil(FUNCTION TestElement(elementIndex: ArrayIndex): Boolean;
                                        IterateForward: Boolean): ArrayIndex;
{ DON'T use EXIT to get out of this routine from your TestElement function or you will be really
sad!  (our debugger will check for you) That's why you can return TRUE to stop enumerating.
Signaling Failure is OK too. }

    VAR
        fi:                 FailInfo;
        myIterationNode:    IterationNode;

    PROCEDURE HdlEachElementDoTil(error: OSErr;
                            message: longint);

        BEGIN
        RemoveNode(@myIterationNode);
        END;

    BEGIN
    EachElementDoTil := kEmptyIndex;
    IF fSize > kEmptyIndex THEN                         { Can't even special case one element lists,
                                                         wouldn't be sure of index to return if the
                                                         TestElement call inserted or deleted. }
        BEGIN
        WITH myIterationNode DO                         { Make sure that the iterIndex counter and
                                                         Iteration direction flag from
                                                         myIterationNode are used so that the
                                                         iterIndex counter can be "bent" if anyone
                                                         else deletes or inserts elements while the
                                                         iteration is in progress. Pretty slick,
                                                         eh? }
            BEGIN
            AppendNode(@myIterationNode);                { link me in to the list of iterations in
                                                         progress }
            CatchFailures(fi, HdlEachElementDoTil);

            iterForward := IterateForward;

            { Note that outer bound of the loop is the value of fSize at the
            time the loop is begun. Changing fSize in the loop has no
            effect on the number of times the loop is executed. }

            iterLowBound := 1;
            iterHighBound := fSize;

            IF IterateForward THEN
                BEGIN
                iterIndex := iterLowBound;
                REPEAT
                    IF TestElement(iterIndex) THEN
                        LEAVE;
                    iterIndex := iterIndex + 1;
                UNTIL iterIndex > iterHighBound;
                END
            ELSE
                BEGIN
                iterIndex := iterHighBound;
                REPEAT
                    IF TestElement(iterIndex) THEN
                        LEAVE;
                    iterIndex := iterIndex - 1;
                UNTIL iterIndex < iterLowBound;
                END;

            { keep index in range }
            IF (iterIndex < kEmptyIndex) | (iterIndex > fSize) THEN
                EachElementDoTil := kEmptyIndex
            ELSE
                EachElementDoTil := iterIndex;

            Success(fi);
            RemoveNode(@myIterationNode);

            { Check if there is a pending free request that couldn't be honored because we were
            iterating and if so… be free! }
            IF fFreeRequested & (fTailNodePtr = NIL) THEN
                Free;

            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.Merge(aDynamicArray: TDynamicArray);

    BEGIN
    IF qDebug & ((fElementSize <> aDynamicArray.fElementSize) | (fElementSizeShift <>
       aDynamicArray.fElementSizeShift)) THEN
        ProgramBreak(
'In TDynamicArray.Merge: fElementSize or fElementSizeShift don''t match with the TDynamicArray to merge!'
                     );

    IF aDynamicArray.GetSize <> kEmptyIndex THEN
        InsertElementsBefore(GetSize + 1, aDynamicArray.ComputeAddress(1), aDynamicArray.GetSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.ReplaceElementsAt(index: ArrayIndex;
                                          ElementPtr: UNIV Ptr;
                                          count: ArrayIndex);

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TDynamicArray.ReplaceElementAt');
        END;

    BlockMove(ElementPtr, ComputeAddress(index), BSL(count, fElementSizeShift));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TDynamicArray.SetArraySize(theSize: ArrayIndex);

    VAR
        newAllocatedSize:    ArrayIndex;

    BEGIN
    IF (theSize > fAllocatedSize) | (fAllocatedSize - theSize >= fAllocationIncrement) THEN
        BEGIN

        IF qDebug & (fAllocationIncrement < 0) THEN
            ProgramBreak('fAllocationIncrement < 0 !  You have serious problems.');

        { Set the # of allocated elements to the nearest multiple of fAllocationIncrement.
        Wait until after the SetDynamicSize to set fAllocatedSize in case SetDynamicSize
        signals failure. }
        IF fAllocationIncrement <> 0 THEN
            newAllocatedSize := (theSize + fAllocationIncrement) - (theSize + fAllocationIncrement)
            MOD fAllocationIncrement
        ELSE
            newAllocatedSize := theSize;

        IF newAllocatedSize <> fAllocatedSize THEN
            SetDynamicSize(BSL(newAllocatedSize, fElementSizeShift));

        fAllocatedSize := newAllocatedSize;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TDynamicArray.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                   fieldAddr: Ptr;
                                                   fieldType: integer)); OVERRIDE;

    BEGIN
    DoToField('TDynamicArray', NIL, bClass);
    DoToField('fSize', @fSize, bLongInt);
    DoToField('fElementSize', @fElementSize, bInteger);
    DoToField('fElementSizeShift', @fElementSizeShift, bInteger);
    DoToField('fAllocationIncrement', @fAllocationIncrement, bLongInt);
    DoToField('fAllocatedSize', @fAllocatedSize, bLongInt);
    DoToField('fFreeRequested', @fFreeRequested, bBoolean);
    DoToField('fClassSize', @fClassSize, bLongInt);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TDynamicArray.DynamicFields(PROCEDURE DoToField(fieldName: Str255;
                                                          fieldAddr: Ptr;
                                                          fieldType: integer)); OVERRIDE;

    FUNCTION DoToElement(theIndex: ArrayIndex): Boolean;

        VAR
            aString:            Str255;

        BEGIN
        DoToElement := FALSE;
        NumToString(theIndex, aString);
        aString := CONCAT('.ComputeAddress[', aString, ']');
        DoToField(aString, ComputeAddress(theIndex), bPointer);
        END;

    BEGIN
    DoToField('Dynamic Fields', NIL, bTitle);

    IF EachElementDoTil(DoToElement, kIterateForward) <> kEmptyIndex THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION NewList: TList;

    VAR
        list:                TList;

    BEGIN
    New(list);
    FailNil(list);
    list.IList;
    NewList := list;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION NewSortedList: TSortedList;

    VAR
        list:                TSortedList;

    BEGIN
    New(list);
    FailNil(list);
    list.IList;
    NewSortedList := list;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION NewAllocatedList(iSize: ArrayIndex): TList;

    VAR
        list:                TList;

    BEGIN
    list := NewList;
    list.SetArraySize(iSize);
    NewAllocatedList := list;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION FreeListIfObject(list: TList): TList;

    BEGIN
    FreeListIfObject := NIL;    { for convenience of caller }

    IF list <> NIL THEN
        BEGIN
        if qDebug THEN
            FailNonObject(list);

        list.FreeList;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.IList;

    BEGIN
    IDynamicArray(kEmptyIndex, sizeof(Handle));         { Can't do sizeof(TObject) because sizeof
                                                         returns the record size for objects }
    fObjClassID := kNilClass;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.At(index: ArrayIndex): TObject;

    BEGIN
    IF qRangeCheck & ((index <= kEmptyIndex) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TList.At');
        END;

    At := TObjectPtr(ComputeAddress(index))^;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.AtDelete(index: ArrayIndex);

    BEGIN
    IF qRangeCheck & ((index <= kEmptyIndex) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TList.AtDelete');
        END;

    DeleteElementsAt(index, 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.AtPut(index: ArrayIndex;
                      newItem: TObject);

    BEGIN
    IF qRangeCheck & ((index <= kEmptyIndex) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TList.AtPut');
        Failure(minErr, 0);                             { Can't continue, bad index trashes memory
                                                         ??? Would it be nice to have a mechanism
                                                         where the developer could supply a new
                                                         index here? }
        END;

    IF qDebug THEN
        BEGIN
        FailNonObject(newItem);
        IF (fObjClassID <> kNilClass) THEN
            IF NOT IsMemberClassID(newItem, fObjClassID) THEN
                BEGIN
                WrLblPtr('newItem', newItem);
                Writeln;
                ProgramBreak('In TList.AtPut: inserting invalid object type');
                END;
        END;

    TObjectPtr(ComputeAddress(index))^ := newItem;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.Delete(item: TObject);

    VAR
        index:                ArrayIndex;

    BEGIN
    IF qDebug THEN
        FailNonObject(item);
    index := GetSameItemNo(item);
    IF index <> kEmptyIndex THEN
        AtDelete(index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.DeleteAll;

    BEGIN
    IF fSize > kEmptyIndex THEN
        DeleteElementsAt(1, fSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.Each(PROCEDURE DoToItem(item: TObject));

    VAR
        index:                ArrayIndex;

    {$Push} {$IFC qTrace} {$D+} {$ENDC}
    FUNCTION TestItem(item: TObject): Boolean;

        BEGIN
        DoToItem(item);
        TestItem := FALSE;
        END;
    {$Pop}

    BEGIN
    { just use IterateTil with a function that never returns true }
    IF IterateTil(TestItem, kIterateForward, index) <> NIL THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.First: TObject;

    BEGIN
    IF fSize <= kEmptyIndex THEN
        First := NIL
    ELSE
        First := At(1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.FirstThat(FUNCTION TestItem(item: TObject): Boolean): TObject;

    VAR
        index:                ArrayIndex;

    BEGIN
    FirstThat := IterateTil(TestItem, kIterateForward, index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.FreeAll;

    BEGIN
    Each(FreeIfObject);
    DeleteAll;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.FreeList;

    BEGIN
    Each(FreeIfObject);
    Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.GetSameItemNo(item: TObject): ArrayIndex;

    VAR
        index:                ArrayIndex;

    {$Push} {$IFC qTrace} {$D+} {$ENDC}
    FUNCTION TestItem(listItem: TObject): Boolean;

        BEGIN
        IF listItem = item THEN
            TestItem := TRUE
        ELSE
            TestItem := FALSE;
        END;
        {$Pop}

    BEGIN
    IF qDebug THEN
        FailNonObject(item);
    { the equality test should not change the list's size or the resulting index can be invalid }
    IF IterateTil(TestItem, kIterateForward, index) <> NIL THEN;

    GetSameItemNo := index;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.GetEqualItemNo(item: TObject): ArrayIndex;

    BEGIN
    IF qDebug THEN
        FailNonObject(item);
    GetEqualItemNo := GetSameItemNo(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.Insert(item: TObject);

    BEGIN
    { Depend on InsertBefore for sanity checking }
    InsertLast(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.InsertBefore(index: ArrayIndex;
                             item: TObject);

    BEGIN
    IF qRangeCheck & ((index <= kEmptyIndex) | (index > fSize + 1)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TList.InsertBefore');
        END;

    IF qDebug THEN
        BEGIN
        FailNonObject(item);
        IF (fObjClassID <> kNilClass) THEN
            IF NOT IsMemberClassID(item, fObjClassID) THEN
                BEGIN
                WrLblPtr('item', item);
                Writeln;
                ProgramBreak('In TList.InsertBefore: inserting invalid object type');
                END;
        END;

    InsertElementsBefore(index, @item, 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.InsertFirst(item: TObject);

    BEGIN
    { Depend on InsertBefore for sanity checking }
    InsertBefore(1, item);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TList.InsertLast(item: TObject);

    BEGIN
    { Depend on InsertBefore for sanity checking }
    InsertBefore(fSize + 1, item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.IterateTil(FUNCTION TestItem(item: TObject): Boolean;
                          IterateForward: Boolean;
                          VAR itsIndex: ArrayIndex): TObject;

    VAR
        theObjectToReturn:    TObject;

    {$Push} {$IFC qTrace} {$D+} {$ENDC}
    FUNCTION DoToElement(theIndex: ArrayIndex): Boolean;

        VAR
            testResult:         Boolean;
            testedObject:        TObject;

        BEGIN
        testedObject := At(theIndex);                    { we save the object in case the test
                                                         process removes it from the list }
        testResult := TestItem(testedObject);
        DoToElement := testResult;

        { If the test returned true then we need to return the object.  We have to do this
        with a temp because the object may have been removed from the list by TestItem }
        IF testResult THEN
            IterateTil := testedObject;
        END;
        {$Pop}

    BEGIN
    IterateTil := NIL;                                    { if TestItem returns true the
                                                         IterateTil will be set to the
                                                         object that tested true }
    itsIndex := EachElementDoTil(DoToElement, IterateForward);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.Last: TObject;

    BEGIN
    IF fSize <= kEmptyIndex THEN
        Last := NIL
    ELSE
        Last := At(fSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.LastThat(FUNCTION TestItem(item: TObject): Boolean): TObject;

    VAR
        index:                ArrayIndex;

    BEGIN
    LastThat := IterateTil(TestItem, kIterateBackward, index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListDebug}

PROCEDURE TList.SetEltType(toClass: MAName);

    VAR
        s:                    MAName;

    BEGIN
    { Forgive the caller for calling this twice only if the same type was specified both times }
    IF qDebug & (fObjClassID <> kNilClass) THEN
        BEGIN
        GetClassNameFromID(fObjClassID, s);
        IF toClass <> s THEN
            BEGIN
            Writeln('The list already contains ', s, '; trying to change to ', toClass);
            ProgramBreak('In TList.SetEltType');
            END;
        END;
    { Assign the field }
    fObjClassID := GetClassIDFromName(toClass)            { srf 88.9.7 }
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListDebug}

PROCEDURE TList.SetEltTypeID(toClassID: ObjClassID);

    VAR
        s, newClassName:    MAName;

    BEGIN
    { Forgive the caller for calling this twice only if the same type was specified both times }
    IF qDebug & (fObjClassID <> kNilClass) THEN
        BEGIN
        IF fObjClassID <> toClassID THEN
            BEGIN
            GetClassNameFromID(fObjClassID, s);
            GetClassNameFromID(toClassID, newClassName);
            Writeln('The list already contains ', s, '; trying to change to ', newClassName);
            ProgramBreak('In TList.SetEltTypeID');
            END;
        END;
    { Assign the field }
    fObjClassID := toClassID;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.SortBy(FUNCTION CompareItems(item1, item2: TObject): CompareResult);
{!!! Sort would be nice to have at the TDynamicArray level too…  Parameterized types where are you?
NOTE: This doesn't work with a CompareItems Function that inserts or deletes elements. }

    VAR
        i, j, h:            ArrayIndex;
        v, item:            TObject;

    BEGIN
    { Do a nice shell sort.  …For _really_ big lists this isn't fast enough }
    {Initialize}
    h := 1;
    REPEAT
        h := 3 * h + 1
    UNTIL h > fSize;

    {Sort}
    REPEAT
        h := h DIV 3;
        FOR i := h + 1 TO fSize DO
            BEGIN
            v := At(i);
            j := i;
            item := At(j - h);
            WHILE CompareItems(item, v) >= kItem1GreaterThanItem2 DO
                BEGIN
                AtPut(j, item);
                j := j - h;
                IF j <= h THEN
                    LEAVE;
                item := At(j - h);
                END;
            AtPut(j, v);
            END;
    UNTIL h = 1;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                           fieldAddr: Ptr;
                                           fieldType: integer)); OVERRIDE;

    VAR
        aString:            MAName;

    BEGIN
    DoToField('TList', NIL, bClass);

    GetClassNameFromID(fObjClassID, aString);
    DoToField('fObjClassID', @aString, bString);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TList.DynamicFields(PROCEDURE DoToField(fieldName: Str255;
                                                  fieldAddr: Ptr;
                                                  fieldType: integer)); OVERRIDE;

    VAR
        i:                    ArrayIndex;
        aString:            Str255;

    PROCEDURE ShowEntry(obj: TObject);

        BEGIN
        i := i + 1;
        NumToString(i, aString);
        aString := CONCAT('.At[', aString, ']');
        DoToField(aString, @obj, bObject);
        END;

    BEGIN
    DoToField('Dynamic Fields', NIL, bTitle);

    i := kEmptyIndex;
    Each(ShowEntry);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAInspector}

PROCEDURE TList.GetInspectorName(VAR inspectorName: Str255); OVERRIDE;

    VAR
        aStringPtr:         PMAName;

    BEGIN
    IF fObjClassID <> kNilClass THEN
        BEGIN
        aStringPtr := PMAName(@inspectorName);
        GetClassNameFromID(fObjClassID, aStringPtr^);
        inspectorName := CONCAT('Of ', inspectorName);
        inspectorName := CONCAT(inspectorName, ' Size: ');
        inspectorName := CONCATNUMBER(inspectorName, GetSize);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TList.Push(item: TObject);

    BEGIN
    { Depend on InsertBefore for sanity checking }
    InsertLast(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.Pop: TObject;

    BEGIN
    IF fSize = kEmptyIndex THEN
        Pop := NIL
    ELSE
        BEGIN
        Pop := At(fSize);
        AtDelete(fSize);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedList.Compare(item1, item2: TObject): CompareResult;

    BEGIN
    IF ord(item1) > ord(item2) THEN
        Compare := kItem1GreaterThanItem2
    ELSE IF ord(item1) < ord(item2) THEN
        Compare := kItem1LessThanItem2
    ELSE
        Compare := kItem1EqualItem2;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TSortedList.ISortedList;

    BEGIN
    IList;                                                { This method is not strictly required right
                                                         now but we want to require calling it }
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedList.DoSearch(FUNCTION TestItem(anItem: TObject): CompareResult;
                              VAR index: ArrayIndex): TObject;

{ DON'T use EXIT to get out of this routine from your TestItem function or you will be really
sad!  (our debugger will check for you) That's why you can return TRUE to stop enumerating.
Signaling Failure is OK too. }

    VAR
        fi:                 FailInfo;
        myIterationNode:    IterationNode;
        aCompareResult:     CompareResult;
        obj:                TObject;

    PROCEDURE HdlDoSearch(error: OSErr;
                            message: longint);

        BEGIN
        RemoveNode(@myIterationNode);
        END;

    BEGIN
    DoSearch := NIL;

    IF fSize = kEmptyIndex THEN
        index := 1
    ELSE
        WITH myIterationNode DO                         { Make sure that the iterIndex counter and
                                                         Iteration direction flag from
                                                         myIterationNode are used so that the
                                                         iterIndex counter can be "bent" if anyone
                                                         else deletes or inserts elements while the
                                                         iteration is in progress. Pretty slick,
                                                         eh? }
            BEGIN
            AppendNode(@myIterationNode);                { link me in to the list of iterations in
                                                         progress }
            CatchFailures(fi, HdlDoSearch);

            iterForward := kIterateForward;
            iterLowBound := 1;
            iterHighBound := fSize;

            REPEAT
                iterIndex := BSR(iterLowBound + iterHighBound, 1); { (iterLowBound + iterHighBound)
                                                                    DIV 2 }

                IF qDebug THEN
                    FailNonObject(At(iterIndex));

                obj := At(iterIndex);        { in case the index is deleted. }
                aCompareResult := TestItem(obj);

                IF aCompareResult <= kItemGreaterThanCriteria THEN
                    iterHighBound := iterIndex - 1
                ELSE
                    iterLowBound := iterIndex + 1;

            UNTIL (aCompareResult = kItemEqualCriteria) | (iterLowBound > iterHighBound);

            IF aCompareResult = kItemEqualCriteria THEN
                DoSearch := obj
            ELSE IF aCompareResult >= kItemLessThanCriteria THEN
                iterIndex := iterIndex + 1;

            { keep index in range }
            IF (iterIndex < 1) | (iterIndex > fSize + 1) THEN
                index := kEmptyIndex
            ELSE
                index := iterIndex;

            Success(fi);
            RemoveNode(@myIterationNode);

            { Check if there is a pending free request that couldn't be honored because we were
            iterating and if so… be free! }
            IF fFreeRequested & (fTailNodePtr = NIL) THEN
                Free;

            END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedList.GetEqualItemNo(item: TObject): ArrayIndex; OVERRIDE;

    VAR
        index:                ArrayIndex;

        {$Push} {$IFC qTrace} {$D+} {$ENDC}

    FUNCTION TestItem(anItem: TObject): CompareResult;

        BEGIN
        IF qDebug THEN
            FailNonObject(anItem);
        TestItem := Compare(item, anItem);
        END;
    {$Pop}

    BEGIN
    IF qDebug THEN
        FailNonObject(item);
    IF DoSearch(TestItem, index) <> NIL THEN
        GetEqualItemNo := index
    ELSE
        GetEqualItemNo := kEmptyIndex;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TSortedList.Insert(item: TObject);

    VAR
        index:                ArrayIndex;

        {$Push} {$IFC qTrace} {$D+} {$ENDC}

    FUNCTION TestItem(anItem: TObject): CompareResult;

        BEGIN
        IF qDebug THEN
            FailNonObject(anItem);
        TestItem := Compare(item, anItem);
        END;
    {$Pop}

    BEGIN
    IF qDebug THEN
        FailNonObject(item);

    IF DoSearch(TestItem, index) <> NIL THEN;            { discard result }
    InsertBefore(index, item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedList.Search(FUNCTION TestItem(anItem: TObject): CompareResult): TObject;

    VAR
        index:                ArrayIndex;

    BEGIN
    Search := DoSearch(TestItem, index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TSortedList.Sort;

    {$Push} {$IFC qTrace} {$D+} {$ENDC}
    FUNCTION itsCompare(item1, item2: TObject): CompareResult;

        BEGIN
        itsCompare := Compare(item1, item2);
        END;
    {$Pop}

    BEGIN
    SortBy(itsCompare);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TSortedList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                           fieldAddr: Ptr;
                                           fieldType: integer)); OVERRIDE;

    BEGIN
    DoToField('TSortedList', NIL, bClass);

    INHERITED Fields(DoToField);
    END;


{$IFC FALSE}                                            { Not supported in this release (2.0) }
{--------------------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------------------}
(*
{$S ListRes}

PROCEDURE TList.Queue(item: TObject);

    BEGIN
    { Depend on InsertBefore for sanity checking }
    InsertLast(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TList.Dequeue: TObject;

    BEGIN
    Dequeue := First;
    END;
*)

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.ILongintList;
{ Initialize a new list with no elements, i.e., fSize = 0 }

    BEGIN
    IDynamicArray(kEmptyIndex, sizeof(longint));
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.At(index: ArrayIndex): longint;
{ Return the index'th element of the list. }

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TLongintList.At');
        END;

    At := PLongint(ComputeAddress(index))^;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.AtDelete(index: ArrayIndex);
{ Deletes via an index. }

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TLongintList.AtDelete');
        END;

    DeleteElementsAt(index, 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.AtPut(index: ArrayIndex;
                             newItem: longint);
 { Replace the index'th element of the list.
   Range check only if the compile-flag qRangeCheck is TRUE. }

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TLongintList.AtPut');
        END;

    PLongint(ComputeAddress(index))^ := newItem;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.Delete(item: longint);

    VAR
        index:                ArrayIndex;

    BEGIN
    index := GetSameItemNo(item);
    IF index <> kEmptyIndex THEN
        AtDelete(index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.DeleteAll;

    BEGIN
    IF fSize > kEmptyIndex THEN
        DeleteElementsAt(1, fSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.Each(PROCEDURE DoToItem(item: longint));

    VAR
        index:                ArrayIndex;

    FUNCTION TestItem(item: longint): Boolean;

        BEGIN
        DoToItem(item);
        TestItem := FALSE;
        END;

    BEGIN
    { just use IterateTil with a function that never returns true }
    IF IterateTil(TestItem, kIterateForward, index) <> 0 THEN;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.First: longint;
  { Return the first element of the list.
   If the compile-flag qDebug is TRUE & SetEltType was called, verify item's type. }

    BEGIN
    IF fSize <= kEmptyIndex THEN
        First := 0
    ELSE
        First := At(1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.FirstThat(FUNCTION TestItem(item: longint): Boolean): longint;
{ Call DoToItem once for each element of the list, in order. }

    VAR
        index:                ArrayIndex;

    BEGIN
    FirstThat := IterateTil(TestItem, kIterateForward, index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.GetSameItemNo(item: longint): ArrayIndex;
 { Find the first reference to the IDENTITY item in the list.
  If item does not occur, return 0. }

    VAR
        index:                ArrayIndex;

    FUNCTION TestItem(listItem: longint): Boolean;

        BEGIN
        IF listItem = item THEN
            TestItem := TRUE
        ELSE
            TestItem := FALSE;
        END;

    BEGIN
    IF IterateTil(TestItem, kIterateForward, index) <> 0 THEN;

    GetSameItemNo := index;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.GetEqualItemNo(item: longint): ArrayIndex;
 { Find the first reference to item in the list.
  If item does not occur, return 0. }

    BEGIN
    GetEqualItemNo := GetSameItemNo(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.InsertBefore(index: ArrayIndex;
                                    item: longint);
 { Insert a reference to item at the indicated index.
   If the compile-flag qDebug is TRUE & SetEltType was called, verify item's type. }

    BEGIN
    IF qRangeCheck & ((index < 1) | (index > fSize + 1)) THEN
        BEGIN
        Writeln('fSize = ', fSize: 1, '  index = ', index: 1);
        ProgramBreak('Range Check in TLongintList.InsertBefore');
        END;

    InsertElementsBefore(index, @item, 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.InsertFirst(item: longint);
 { Insert a reference to item at the front of the list.
   If the compile-flag qDebug is TRUE & SetEltType was called, verify item's type. }

    BEGIN
    InsertBefore(1, item);
    END;

{--------------------------------------------------------------------------------------------------}

PROCEDURE TLongintList.InsertLast(item: longint);
 { Insert a reference to item at the back of the list.
   If qDebug is TRUE & SetEltType was called, check that item's type is correct. }

    BEGIN
    InsertBefore(fSize + 1, item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.IterateTil(FUNCTION TestItem(item: longint): Boolean;
                                 IterateForward: Boolean;
                                 VAR itsIndex: ArrayIndex): longint;
{ Call TestItem once for each element of the list, in order. }

    FUNCTION DoToElement(theIndex: ArrayIndex): Boolean;

        BEGIN
        DoToElement := TestItem(At(theIndex));
        END;

    BEGIN
    itsIndex := EachElementDoTil(DoToElement, IterateForward);
    IF itsIndex <> kEmptyIndex THEN
        IterateTil := At(itsIndex)
    ELSE
        IterateTil := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.Last: longint;
 { Return the last element of the list.
   If the compile-flag qDebug is TRUE & SetEltType was called, verify item's type. }

    BEGIN
    IF fSize <= kEmptyIndex THEN
        Last := 0
    ELSE
        Last := At(fSize);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.LastThat(FUNCTION TestItem(item: longint): Boolean): longint;
{ Call DoToItem once for each element of the list, in order. }

    VAR
        index:                ArrayIndex;

    BEGIN
    LastThat := IterateTil(TestItem, kIterateBackward, index);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TLongintList.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                  fieldAddr: Ptr;
                                                  fieldType: integer)); OVERRIDE;

    BEGIN
    DoToField('TLongintList', NIL, bClass);

    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TLongintList.DynamicFields(PROCEDURE DoToField(fieldName: Str255;
                                                         fieldAddr: Ptr;
                                                         fieldType: integer)); OVERRIDE;

    VAR
        i:                    ArrayIndex;
        aString:            Str255;

    PROCEDURE ShowEntry(itsVal: longint);

        BEGIN
        i := i + 1;
        NumToString(i, aString);
        aString := CONCAT('.At[', aString, ']');
        DoToField(aString, @itsVal, bLongInt);
        END;

    BEGIN
    DoToField('Dynamic Fields', NIL, bTitle);

    i := kEmptyIndex;
    Each(ShowEntry);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TLongintList.Push(item: longint);
{ LIFO stack push. }

    BEGIN
    InsertLast(item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TLongintList.Pop: longint;
{ LIFO stack pop }

    BEGIN
    IF fSize = kEmptyIndex THEN
        Pop := 0
    ELSE
        BEGIN
        Pop := At(fSize);
        AtDelete(fSize);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedLongintList.Compare(item1, item2: longint): CompareResult;
{ By default just compare the ordinal value of the items.  Subclasses that want to use the items
as pointers or other types should override if the comparison is based on the pointed at value }

    BEGIN
    IF item1 > item2 THEN
        Compare := kItem1GreaterThanItem2
    ELSE IF item1 < item2 THEN
        Compare := kItem1LessThanItem2
    ELSE
        Compare := kItem1EqualItem2;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedLongintList.DoSearch(FUNCTION TestItem(anItem: longint): CompareResult;
                                     VAR index: ArrayIndex): ArrayIndex;
{ DON'T use EXIT to get out of this routine from your TestItem function or you will be really
sad!  (our debugger will check for you) That's why you can return TRUE to stop enumerating.
Signaling Failure is OK too. }

    VAR
        fi:                 FailInfo;
        myIterationNode:    IterationNode;
        aCompareResult:     CompareResult;

    PROCEDURE HdlDoSearch(error: OSErr;
                            message: longint);

        BEGIN
        RemoveNode(@myIterationNode);
        END;

    BEGIN
    DoSearch := 0;

    IF fSize = 0 THEN
        index := 1
    ELSE
        WITH myIterationNode DO                         { Make sure that the iterIndex counter and
                                                         Iteration direction flag from
                                                         myIterationNode are used so that the
                                                         iterIndex counter can be "bent" if anyone
                                                         else deletes or inserts elements while the
                                                         iteration is in progress. Pretty slick,
                                                         eh? }
            BEGIN
            AppendNode(@myIterationNode);                { link me in to the list of iterations in
                                                         progress }
            CatchFailures(fi, HdlDoSearch);

            iterForward := IterateForward;
            iterLowBound := 1;
            iterHighBound := fSize;
            REPEAT
                iterIndex := BSR(iterLowBound + iterHighBound, 1); { (iterLowBound + iterHighBound)
                                                                    DIV 2 }
                aCompareResult := TestItem(At(iterIndex));
                IF aCompareResult <= kItemGreaterThanCriteria THEN
                    iterHighBound := iterIndex - 1
                ELSE
                    iterLowBound := iterIndex + 1;
            UNTIL (aCompareResult = kItemEqualCriteria) | (iterLowBound > iterHighBound);
            IF aCompareResult = kItemEqualCriteria THEN
                DoSearch := At(iterIndex)
            ELSE IF aCompareResult >= kItemLessThanCriteria THEN
                iterIndex := iterIndex + 1;

            { keep index in range }
            IF (iterIndex < 1) | (iterIndex > fSize + 1) THEN
                index := kEmptyIndex
            ELSE
                index := iterIndex;

            Success(fi);
            RemoveNode(@myIterationNode);

            { Check if there is a pending free request that couldn't be honored because we were
            iterating and if so… be free! }
            IF fFreeRequested & (fTailNodePtr = NIL) THEN
                Free;

            END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedLongintList.GetEqualItemNo(item: longint): ArrayIndex; OVERRIDE;

    VAR
        index:                ArrayIndex;

        {$Push} {$IFC qTrace} {$D+} {$ENDC}

    FUNCTION TestItem(anItem: longint): CompareResult;

        BEGIN
        TestItem := Compare(item, anItem);
        END;
    {$Pop}

    BEGIN
    IF DoSearch(TestItem, index) <> 0 THEN
        GetEqualItemNo := index
    ELSE
        GetEqualItemNo := kEmptyIndex;
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

PROCEDURE TSortedLongintList.Insert(item: longint);

    VAR
        index:                ArrayIndex;

        {$Push} {$IFC qTrace} {$D+} {$ENDC}

    FUNCTION TestItem(anItem: longint): CompareResult;

        BEGIN
        TestItem := Compare(item, anItem);
        END;
    {$Pop}

    BEGIN
    IF DoSearch(TestItem, index) <> 0 THEN;
    InsertBefore(index, item);
    END;

{--------------------------------------------------------------------------------------------------}
{$S ListRes}

FUNCTION TSortedLongintList.Search(FUNCTION TestItem(anItem: longint): CompareResult): longint;

    VAR
        index:                integer;

    BEGIN
    Search := DoSearch(TestItem, index);
    END;

{$EndC}